home *** CD-ROM | disk | FTP | other *** search
#!---------------------------------------------------------! #! ! #! Copyright 1994, 1995 ToolCraft Development Corporation ! #! ! #! ALL RIGHTS RESERVED ! #! ! #!---------------------------------------------------------! #! #! #!=============================================================================! #! ! #! Page/Loaded Drop Combo List Box Control ! #! ! #!=============================================================================! #CONTROL(DropComboBrowse,'Page Loaded Drop Combo Browse Box'),PRIMARY('PB DropCombo Control'),REQ(PowerBrowseLibrary(ToolCraft)),DESCRIPTION('PB DropCombo on ' & %Primary),MULTI CONTROLS COMBO(@S40),AT(,,80,10),USE(ComboEntry),DROP(6),IMM,VSCROLL,FROM(BRWQ) END #BUTTON('DropCombo Browse Box Behavior'),AT(10,,180) #SHEET #TAB('C&onfiguration'),HLP('~BrowseBox'),HLP('~PBDropComboBrowseConfigurationTab') #PROMPT('Use &View Structure',CHECK),%UsingViewStructure,AT(10,30,105) #PROMPT('Refresh &Window After Selection is Made',CHECK),%RefreshWindowOnSelection,AT(10,,140) #PROMPT('Enable "Hot" &Display Fields',CHECK),%HotDisplay,AT(10,,105) #PROMPT('Enable Last Entry Restore on ESC Key',CHECK),%ComboRestoreOnESC,AT(10,,135),DEFAULT(1) #PROMPT('&Update Procedure:',PROCEDURE),%ComboUpdateProcedure,AT(,80),PROMPTAT(,80) #PROMPT('Relate to For&m Using:',DROP('Field Value|Non-Related Key')),%ComboRelationType,DEFAULT('Field Value'),AT(,100),PROMPTAT(,100) #BOXED,WHERE(%ComboRelationType='Non-Related Key') #PROMPT('Lookup &Key:',KEY(%Primary)),%ComboLookupKey,AT(97,112,87,10),PROMPTAT(10,112,87,10) #VALIDATE(%ComboLookupKey,'You must select a Lookup Key') #ENABLE(%ComboLookupKey),CLEAR #PROMPT('Lookup &Field:',FIELD(%Primary)),%ComboLookupField,AT(97,124,87,10),PROMPTAT(10,124,87,10) #VALIDATE(%ComboLookupField,'You must select a Lookup Field') #ENDENABLE #PROMPT('&Related Field:',FIELD),%ComboRelatedField,AT(97,136,87,10),PROMPTAT(10,136,87,10) #VALIDATE(%ComboRelatedField,'You must select a Related Field') #ENDBOXED #ENDTAB #TAB('&Display Setup'),HLP('~PBDropComboBrowseDisplaySetupTab') #PROMPT('Key Display &Order:',DROP('Normal|Reverse')),%KeyDisplayOrder,DEFAULT('Normal'),AT(,30),PROMPTAT(,30) #PROMPT('&Locator:',DROP('None|Auto Fill')),%ComboLocatorType,DEFAULT('Auto Fill'),AT(,45),PROMPTAT(,45) #PROMPT('&Record Filter:',@S180),%RecordFilter,AT(,60),PROMPTAT(,60) #PROMPT('Range Limit &Field:',COMPONENT(%PrimaryKey)),%RangeField,AT(,75),PROMPTAT(,75) #ENABLE(%RangeField) #PROMPT('Range Limit &Type:',DROP('Current Value|Single Value|Range of Values|File Relationship')),%RangeLimitType,DEFAULT('Current Value') #BOXED,WHERE(%RangeLimitType='Single Value') #PROMPT('&Range Limit Value:',@s100),%RangeLimit,AT(97,102,87,10),PROMPTAT(10,102,87,10) #ENDBOXED #BOXED,WHERE(%RangeLimitType='Range of Values') #PROMPT('&Low Limit Value:',@S100),%RangeLow,AT(97,102,87,10),PROMPTAT(10,102,87,10) #PROMPT('&High Limit Value:',@S100),%RangeHigh,AT(97,115,87,10),PROMPTAT(10,115,87,10) #ENDBOXED #BOXED,WHERE(%RangeLimitType='File Relationship') #PROMPT('&Related File:',FILE),%RangeFile,AT(97,102,87,10),PROMPTAT(10,102,87,10) #ENDBOXED #ENDENABLE #BUTTON('Vertical Scroll Bar Behavior'),HLP('~PBScrollBarOptions'),AT(,130,176) #PROMPT('Scroll Bar Behavior:',DROP('Fixed Thumb|Movable Thumb')),%ScrollBehavior,DEFAULT('Fixed Thumb') #ENABLE(%ScrollBehavior='Movable Thumb') #PROMPT('Key Distribution:',DROP('Alpha|Last Names|Numeric Range|Date Range|Custom|Other')),%ScrollKeyDistribution,DEFAULT('Alpha') #BOXED,WHERE(%ScrollKeyDistribution='Custom') #BUTTON('Custom Key Distribution'),MULTI(%CustomKeyDistribution,%KeyDistributionValue),AT(10,35,180),HLP('~PBScrollBehaviorCustomKeyDistribution') #PROMPT('Key Value:',@S10),%KeyDistributionValue #ENDBUTTON #ENDBOXED #BOXED,WHERE(%ScrollKeyDistribution='Numeric Range') #PROMPT('From Value:',@S20),%KeyArrayFromValue,AT(100,35,90,10),PROMPTAT(10,35,90,10) #PROMPT('Thru Value:',@S20),%KeyArrayThruValue,AT(100,47,90,10),PROMPTAT(10,47,90,10) #ENDBOXED #BOXED,WHERE(%ScrollKeyDistribution='Date Range') #PROMPT('From Date:',@D2),%KeyArrayFromDate,AT(100,35,90,10),PROMPTAT(10,35,90,10) #PROMPT('Thru Date:',@D2),%KeyArrayThruDate,AT(100,47,90,10),PROMPTAT(10,47,90,10) #ENDBOXED #BOXED,WHERE(%ScrollKeyDistribution='Other') #PROMPT('Key Array Name:',@S40),%KeyArrayName,AT(100,35,90,10),PROMPTAT(10,35,90,10) #ENDBOXED #ENDENABLE #ENDBUTTON #ENDTAB #TAB('&View'),WHERE(NOT %UsingViewStructure),HLP('~PBDropComboBrowseViewTab') #DISPLAY('Use of a view structure for this browse has not been'),AT(,30) #DISPLAY('enabled. To have the browse use a view you must first') #DISPLAY('check the "Use View Structure" option from the') #DISPLAY('Configuration properties page. After you complete this') #DISPLAY('step you will be able to change view properties from') #DISPLAY('this page.') #ENDTAB #TAB('&View'),WHERE(%UsingViewStructure),HLP('~PBDropComboBrowseViewTab') #PROMPT('&Filter:',@S180),%ViewStructureFilter,PROMPTAT(10,30,25),AT(30,30,153) #DISPLAY('"Hot" Fields:'),AT(,45) #BUTTON('"Hot" Fields'),MULTI(%HotFields,%HotField & SUB(' (BIND)',1,7*%HotFieldBound)),HLP('~PBViewHotFields'),INLINE,AT(,,,85) #PROMPT('Hot Field:',FIELD),%HotField #VALIDATE(%HotField,'You Must Select a Hot Field') #PROMPT('BIND Field:',CHECK),%HotFieldBound #ENDBUTTON #ENDTAB #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #TAB('&Colors'),WHERE(NOT %ControlHasColor),HLP('~PBDropComboBrowseColorsTab') #DISPLAY('No color options were checked in the list box formatter.'),AT(,30) #DISPLAY('To enable colors in a list box you must first check the') #DISPLAY('color option for each field that will use coloring.') #DISPLAY('After you complete this step you a will be able to set the') #DISPLAY('color properties for each field from this page.') #ENDTAB #TAB('&Colors'),WHERE(%ControlHasColor = %True),HLP('~PBDropComboBrowseColorsTab') #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #BUTTON('Customize Colors'),FROM(%ControlField,%ControlField),AT(,30),HLP('~PBCustomizeColors'),INLINE,WHERE(%ControlFieldHasColor) #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #BOXED('Default Colors') #PROMPT('&Foreground Normal:',COLOR),%ControlFieldForegroundNormal,DEFAULT(-1) #PROMPT('&Background Normal:',COLOR),%ControlFieldBackgroundNormal,DEFAULT(-1) #PROMPT('&Foreground Selected:',COLOR),%ControlFieldForegroundSelected,DEFAULT(-1) #PROMPT('&Background Selected:',COLOR),%ControlFieldBackgroundSelected,DEFAULT(-1) #ENDBOXED #BOXED('Conditional Color Assignments') #BUTTON('Conditional Color Assignments'),MULTI(%ConditionalColors,%ColorCondition),INLINE,HLP('~PBConditionalColors') #PROMPT('&Condition:',@S255),%ColorCondition #PROMPT('&Foreground Normal:',COLOR),%ConditionalControlFieldForegroundNormal,DEFAULT(-1) #PROMPT('&Background Normal:',COLOR),%ConditionalControlFieldBackgroundNormal,DEFAULT(-1) #PROMPT('&Foreground Selected:',COLOR),%ConditionalControlFieldForegroundSelected,DEFAULT(-1) #PROMPT('&Background Selected:',COLOR),%ConditionalControlFieldBackgroundSelected,DEFAULT(-1) #ENDBUTTON #ENDBOXED #ENDBUTTON #ENDTAB #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #TAB('&Icons'),WHERE(NOT %ControlHasIcon),HLP('~PBDropComboBrowseIconsTab') #DISPLAY('No icons fields were defined in the list box formatter.'),AT(,30) #DISPLAY('To define an icon in a list box you must first check the') #DISPLAY('icon option for each field that will display an icon.') #DISPLAY('After you complete this step you a will be able to set the') #DISPLAY('icon properties for each field from this page.') #ENDTAB #TAB('&Icons'),WHERE(%ControlHasIcon = %True),HLP('~PBDropComboBrowseIconsTab') #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #BUTTON('&Customize Icons'),FROM(%ControlField,%ControlField & ' - ' & %ControlFieldIcon),AT(,30),HLP('~PBCustomizeIcons'),INLINE,WHERE(%ControlFieldHasIcon) #PREPARE #FIND(%ControlInstance,%ActiveTemplateInstance,%Control) #ENDPREPARE #BOXED('Default Icon') #PROMPT('Icon:',@S40),%ControlFieldIcon #ENDBOXED #BOXED('Conditional Icon Usage') #BUTTON('&Conditional Icon Usage'),MULTI(%ConditionalIcons,%IconCondition),INLINE,HLP('~PBConditionalIcons') #PROMPT('&Condition:',@S255),%IconCondition #PROMPT('Icon:',@S40),%ConditionalControlFieldIcon #ENDBUTTON #ENDBOXED #ENDBUTTON #ENDTAB #ENDSHEET #ENDBUTTON #CLASS('Format Browse','Format a variable in the ' & %ActiveTemplateInstanceDescription) #! #! #! #!------------------------------------------------------------------------- #ATSTART #DECLARE(%UsingDropCombo) #SET(%UsingDropCombo,1) #DECLARE(%UsingMultiDisplay) #CLEAR(%UsingMultiDisplay) #DECLARE(%UsingInLineEntry) #CLEAR(%UsingInLineEntry) #DECLARE(%UpdateProcedure) #CLEAR(%UpdateProcedure) #DECLARE(%RelationToListBoxes) #SET(%RelationToListBoxes,'None') #DECLARE(%ParentListControl) #CLEAR(%ParentListControl) #DECLARE(%LocatorName) #CLEAR(%LocatorName) #DECLARE(%LocatorField) #DECLARE(%LocatorControl) #DECLARE(%LocatorType) #SET(%LocatorType,'Combo') #DECLARE(%CmbNo) #SET(%CmbNo,%ActiveTemplateInstance) #DECLARE(%CmtPos) #SET(%CmtPos,65) #COMMENT(%CmtPos) #DECLARE(%UsingRevKeyOrder) #IF(%KeyDisplayOrder = 'Reverse') #SET(%UsingRevKeyOrder,%True) #ELSE #SET(%UsingRevKeyOrder,%False) #ENDIF #INSERT(%FileControlInitialize(Clarion)) #INSERT(%BrowseBoxControlInitialize) #INSERT(%BuildQueueFieldList) #INSERT(%SetupSingleDisplay) #INSERT(%BuildColorConstruct) #INSERT(%BuildIconConstruct) #ENDAT #!------------------------------------------------------------------------- #AT(%CustomGlobalDeclarations) #INSERT(%FileControlSetFlags(Clarion)) #ENDAT #!------------------------------------------------------------------------- #AT(%SetIconListProperties),WHERE(%ListBoxHasIcon) #INSERT(%AddAllIconsForControl) #ENDAT #!------------------------------------------------------------------------- #AT(%SaveFieldsForRangeFilter) #INSERT(%GenerateSaveVars) #INSERT(%GenerateComboSaveVars) #ENDAT #!------------------------------------------------------------------------- #AT(%ProcedureSetup) #INSERT(%InitializeSaveVars) #ENDAT #!------------------------------------------------------------------------- #AT(%MultiSortOrderDeclarations) #!#INSERT(%BuildFormatStrings) #! #ENDAT #!------------------------------------------------------------------------- #AT(%DataSectionBeforeWindow) #IF(%ScrollBehavior='Movable Thumb') #CASE(%ScrollKeyDistribution) #OF('Numeric Range') #IF(%KeyArrayThruValue < %KeyArrayFromValue) #SET(%KeyArrayThruValue,%KeyArrayFromValue) #ENDIF #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') %[20]ValueConstruct LIKE(%ThumbLocatorField) #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':RangeFrom') %[20]ValueConstruct EQUATE(%KeyArrayFromValue) #SET(%ValueConstruct,%KeyArrayThruValue - %KeyArrayFromValue + 1) #SET(%ArrayRangeStep,%ValueConstruct / 100) #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':RangeStep') %[20]ValueConstruct EQUATE(%ArrayRangeStep) #OF('Date Range') #IF(%KeyArrayThruDate < %KeyArrayFromDate) #SET(%KeyArrayThruDate,%KeyArrayFromDate) #ENDIF #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') %[20]ValueConstruct LIKE(%ThumbLocatorField) #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':RangeFrom') %[20]ValueConstruct EQUATE(%KeyArrayFromDate) #SET(%ValueConstruct,%KeyArrayThruDate - %KeyArrayFromDate + 1) #SET(%ArrayRangeStep,%ValueConstruct / 100) #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':RangeStep') %[20]ValueConstruct EQUATE(%ArrayRangeStep) #OF('Custom') #CLEAR(%CustomSize) #CLEAR(%CustomStrLen) #FOR(%CustomKeyDistribution) #IF(%CustomSize < LEN(CLIP(%KeyDistributionValue))) #SET(%CustomSize,LEN(CLIP(%KeyDistributionValue))) #ENDIF #ENDFOR #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':Custom') %[20]ValueConstruct STRING('%| #FOR(%CustomKeyDistribution) #IF(%CustomStrLen => 60) %SnglQuote | &'%| #CLEAR(%CustomStrLen) #ENDIF #SET(%CustomStrLen,%CustomStrLen + %CustomSize) %[%CustomSize]KeyDistributionValue%| #ENDFOR %SnglQuote) #SET(%ArrayOverField,'SORT:' & %BrwLbl & ':Custom') #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':Custom:Array') #SET(%ArrayDimSize,ITEMS(%CustomKeyDistribution)) %[20]ValueConstruct STRING(%CustomSize),DIM(%ArrayDimSize),OVER(%ArrayOverField) #ENDCASE #ENDIF #ENDAT #!------------------------------------------------------------------------- #AT(%BrowseQueueDeclaration) #INSERT(%BuildBrowseBoxQueue) #IF(%UsingViewStructure) #SET(%ValueConstruct,'VIEW:' & %ListQueue) #INSERT(%ConstructView) #ENDIF #IF(%UsingRevKeyOrder) #SET(%ValueConstruct,'KeyOrder:' & %BrwLbl) %[20]ValueConstruct STRING('<255>') #ENDIF #ENDAT #!------------------------------------------------------------------------- #AT(%AfterFileOpen),WHERE(%UsingViewStructure) #FOR(%HotFields),WHERE(%HotFieldBound) BIND('%HotField',%HotField) #ENDFOR #ENDAT #!------------------------------------------------------------------------- #AT(%BeforeFileClose),WHERE(%UsingViewStructure) #FOR(%HotFields),WHERE(%HotFieldBound) UNBIND('%HotField') #ENDFOR CLOSE(VIEW:%ListQueue) #ENDAT #!------------------------------------------------------------------------- #AT(%RefreshWindowBeforeDisplay) DO BrowseCombo:%BrwLbl #ENDAT #!------------------------------------------------------------------------- #AT(%ProcedureRoutines) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #INSERT(%BrowseComboRoutine) #INSERT(%ComboAutoFillSearchRoutine) #INSERT(%SetFieldIconsRoutine) #INSERT(%SetFieldColorsRoutine) #INSERT(%AddComboRecordRoutine) #ENDAT #!------------------------------------------------------------------------- #AT(%EndOfProcedure) FREE(%ListQueue) #<!Release Memory use by Browse Queue #ENDAT #!------------------------------------------------------------------------- #AT(%ControlPostEventCaseHandling,%ListControl),WHERE(%ProcedureTemplate <> 'PowerBrowse') #EMBED(%BeforeCallBrowseListRoutine,'Just Before Calling BrowseCombo Routine'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) DO BrowseCombo:%BrwLbl #<! Fill Browse Area #EMBED(%AfterCallBrowseListRoutine,'Just After Calling BrowseCombo Routine'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #ENDAT #!------------------------------------------------------------------------- #AT(%CallBrowseListRoutine,%Control),WHERE(%ProcedureTemplate = 'PowerBrowse') #EMBED(%BeforeCallBrowseListRoutine,'Just Before Calling BrowseList Routine'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) DO BrowseCombo:%BrwLbl #<! Fill Browse Area #EMBED(%AfterCallBrowseListRoutine,'Just After Calling BrowseList Routine'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #ENDAT #!------------------------------------------------------------------------- #AT(%ControlEventHandling,%ListControl,'Accepted') #IF(%ComboLocatorType = 'Auto Fill') IF NOT TARGET{PROP:AcceptAll} AND NOT TC_PROP:BRW(%ListControl,TCPROP:DroppedDown) POST(TCEVENT:AcceptSelection,%ListControl) END #ENDIF #IF(%ComboUpdateProcedure) DO AddComboRecord:%BrwLbl CYCLE #ENDIF #ENDAT #!------------------------------------------------------------------------- #AT(%ControlEventHandling,%ListControl,'NewSelection') #IF(%ComboLocatorType = 'Auto Fill') DO AutoFillSearch:%BrwLbl CYCLE #ENDIF #ENDAT #!------------------------------------------------------------------------- #AT(%ControlOtherEventHandling,%ListControl),WHERE(%RefreshWindowOnSelection) IF EVENT() = TCEVENT:RejectSelection #<!If Combo Field Selection was Rejected POST(TCEVENT:AcceptSelection,%ListControl) #<! Force Accept Before Window Refresh END #<!End IF EVENT() = TCEVENT:AcceptSelection #<!If Combo Field Selection was Made DO RefreshWindow #<! Force Window Refresh END #<!End #ENDAT #!------------------------------------------------------------------------- #AT(%ControlEventHandling,%ListControl,'DroppingDown') #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #INSERT(%SetComboSaveVariables) %LocatorName = %ControlUse SET(%Key,%Key) NEXT(%File) TC_PROP:BRW(%ListControl,TCPROP:Action,TCACTION:Refresh) TC_PROP:BRW(%ListControl,TCPROP:SetToPosition,1) #ENDAT #!------------------------------------------------------------------------- #! #! #!------------------------------------------------------------------------- #GROUP(%InitializeDropComboField) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #IF(%ComboRestoreOnESC) IF EVENT() = TCEVENT:RejectSelection OR | #<!If User Rejected Combo Selection OR NOT TC_PROP:BRW(%ListControl,TCPROP:Initialized) #<! Browse Not Intialized IF EVENT() = TCEVENT:RejectSelection #<! If User Rejected Combo Selection #INSERT(%RestoreComboSaveVariables) END #<! End If #ELSE IF NOT TC_PROP:BRW(%ListControl,TCPROP:Initialized) #<!If Browse Not Intialized #ENDIF CLEAR(%FilePrefix:RECORD) #<! Clear Record Area #EMBED(%InitializeDropCombo,'Initialize Drop Combo'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #CASE(%ComboRelationType) #OF('Field Value') %LocatorName = %ListControlUse #<! Set Lookup Key Value GET(%File,%Key) #<! Get Current Record #OF('Non-Related Key') %ComboLookupField = %ComboRelatedField #<! Set Lookup Key Values GET(%File,%ComboLookupKey) #<! Get Current Record #ENDCASE %ListControlUse = %LocatorName #<! Set Combo Field Value DISPLAY(%ListControl) #<! Redisplay Combo Field END #<!End If IF EVENT() = TCEVENT:AcceptSelection #<!If User Accepted combo Selection #INSERT(%SetRelatedComboFields) %ListControlUse = %LocatorName #<! Set Combo Field Value DISPLAY(%ListControl) #<! Redisplay Combo Field %ListControl{PROP:Touched}=FALSE #<! Set Field as Changed END #<!End If #!------------------------------------------------------------------------- #GROUP(%SetRelatedComboFields) #EMBED(%SetRelatedDropComboFields,'Set Related Drop Combo Fields'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #CASE(%ComboRelationType) #OF('Field Value') %ListControlUse = %LocatorName #<! Set Related Combo Field #OF('Non-Related Key') %ComboRelatedField = %ComboLookupField #<! Set Related Combo Field #ENDCASE #!------------------------------------------------------------------------- #GROUP(%GenerateComboSaveVars) #IF(%ComboRestoreOnESC) #CASE(%ComboRelationType) #OF('Field Value') #SET(%ValueConstruct,'CMBSAV' & %CmbNo & ':' & %LocatorName) %[32]ValueConstruct LIKE(%LocatorName) #<! Combo Save Field Value for Restore #OF('Non-Related Key') #SET(%ValueConstruct,'CMBSAV' & %CmbNo & ':' & %ComboRelatedField) %[32]ValueConstruct LIKE(%ComboRelatedField) #<! Combo Save Field Value for Restore #ENDCASE #ENDIF #!------------------------------------------------------------------------- #GROUP(%SetComboSaveVariables) #IF(%ComboRestoreOnESC) #CASE(%ComboRelationType) #OF('Field Value') CMBSAV%CmbNo:%LocatorName = %LocatorName #<! Save Copy of Current Combo Value #OF('Non-Related Key') CMBSAV%CmbNo:%ComboRelatedField = %ComboRelatedField #<! Save Copy of Current Combo Value #ENDCASE #ENDIF #!------------------------------------------------------------------------- #GROUP(%RestoreComboSaveVariables) #IF(%ComboRestoreOnESC) #CASE(%ComboRelationType) #OF('Field Value') %LocatorName = CMBSAV%CmbNo:%LocatorName #<! Restore to Value Before Dropping Down #OF('Non-Related Key') %ComboRelatedField = CMBSAV%CmbNo:%ComboRelatedField #<! Restore to Value Before Dropping Down #ENDCASE #ENDIF #!------------------------------------------------------------------------- #GROUP(%BrowseComboRoutine) #COMMENT(100) !--------------------------------------------------------------------------------------------------! ! BrowseCombo:%BrwLbl Routine #<! ! ! ! This routine calls the browser to do a page-loaded combo display from a file. ! !--------------------------------------------------------------------------------------------------! #COMMENT(%CmtPos) #SET(%ValueConstruct,'BrowseCombo:' & %BrwLbl) %[20]ValueConstruct ROUTINE #INSERT(%InitializeDropComboField) IF NOT TC_PROP:BRW(%ListControl,TCPROP:Initialized) #<!If Browse Not Initialized IF NOT TC_InitBrowse(%ListControl,THREAD()) THEN EXIT. #<! Initialize Browse Processing for List Box #IF(NOT %UsingMultiDisplay AND %ScrollBehavior='Movable Thumb') TC_PROP:BRW(%ListControl,TCPROP:ThumbOption,1) #<! Use Thumb Control Actions #ENDIF #IF(%UsingViewStructure) TC_PROP:BRW(%ListControl,TCPROP:UseView,1) #<! Use a View Structure #ENDIF END #<!End If #<! IF NOT TC_PROP:BRW(%ListControl,TCPROP:DroppedDown) #<!If Combo is Not Dropped Down EXIT #<! Don't Call Browse Procedure END #<!End #<! LOOP #<!Process File Browse Loop #IF(%KeyDisplayOrder = 'Reverse') TC_PROP:BRW(%ListControl,TCPROP:RevOrder,RevOrder:%BrwLbl) #<! Set Reverse Ordering Flag #ENDIF #FOR(%KeyField) #IF(%KeyFieldSequence='DESCENDING') TC_PROP:BRW(%ListControl,TCPROP:DescendingKey,True) #<! Set Descending Key Flag #ENDIF #ENDFOR TC_Browse(%[20]ListControl ,| #<! Browse Handle #IF(%UsingViewStructure) VIEW:%[15]ListQueue ,| #<! File Name #ELSE %[20]File ,| #<! File Name #ENDIF #SET(%ValueConstruct,%FilePrefix & ':RECORD') %[20]ValueConstruct ,| #<! Record Area %[20]Key ,| #<! Key Order for Display %[20]ListQueue ,| #<! Queue Name for List #IF(%RangeField) #IF(%FilterKeySeg1) #SET(%EndOfProcedureCall,',|') #ELSE #SET(%EndOfProcedureCall,')') #ENDIF #SET(%ValueConstruct,%BrwLbl & ':Position') %[20]ValueConstruct ,| #<! Record Position in Key Order #IF(%RangeIsString = 'GROUP') #SET(%ValueConstruct,'GRP:' & %RangeField) %[20]ValueConstruct ,| #<! Range Field #ELSE %[20]RangeField ,| #<! Range Field #ENDIF #IF(%RangeIsString) #SET(%ValueConstruct,'True') #CASE(%RangeLimitType) #OF('Current Value') #SET(%SaveRangeField,'SAVE:' & %BrwLbl & ':' & %RangeField) %[20]SaveRangeField ,| #<! Match Range - Low Value %[20]SaveRangeField ,| #<! Match Range - High Value %[20]ValueConstruct %EndOfProcedureCall #<! Range Field is a String Flag #OF('Single Value') %[20]RangeLimit ,| #<! Match Range - Low Value %[20]RangeLimit ,| #<! Match Range - High Value %[20]ValueConstruct %EndOfProcedureCall #<! Range Field is a String #OF('Range of Values') %[20]RangeLow ,| #<! Match Range - Low Value %[20]RangeHigh ,| #<! Match Range - High Value %[20]ValueConstruct %EndOfProcedureCall #<! Range Field is a String Flag #OF('File Relationship') %[20]RelationRangeLimit ,| #<! Match Range - Low Value %[20]RelationRangeLimit ,| #<! Match Range - High Value %[20]ValueConstruct %EndOfProcedureCall #<! Range Field is a String #ENDCASE #ELSE #CASE(%RangeLimitType) #OF('Current Value') #SET(%SaveRangeField,'SAVE:' & %BrwLbl & ':' & %RangeField) %[20]SaveRangeField ,| #<! Match Range - Low Value %[20]SaveRangeField %EndOfProcedureCall #<! Match Range - High Value #OF('Single Value') %[20]RangeLimit ,| #<! Match Range - Low Value %[20]RangeLimit %EndOfProcedureCall #<! Match Range - High Value #OF('Range of Values') %[20]RangeLow ,| #<! Match Range - Low Value %[20]RangeHigh %EndOfProcedureCall #<! Match Range - High Value #OF('File Relationship') %[20]RelationRangeLimit ,| #<! Match Range - Low Value %[20]RelationRangeLimit %EndOfProcedureCall #<! Match Range - High Value #ENDCASE #IF(%FilterKeySeg1) #SET(%ValueConstruct,'False') %[20]ValueConstruct ,| #<! Range Field is a String Flag #ENDIF #ENDIF #IF(%FilterKeySeg3) %[20]FilterKeySeg3 ,| #<! Filter Key Component %[20]FilterKeySegLink3 ,| #<! Filter Key Component Value #ENDIF #IF(%FilterKeySeg2) %[20]FilterKeySeg2 ,| #<! Filter Key Component %[20]FilterKeySegLink2 ,| #<! Filter Key Component Value #ENDIF #IF(%FilterKeySeg1) %[20]FilterKeySeg1 ,| #<! Filter Key Component %[20]FilterKeySegLink1 ) #<! Filter Key Component Value #ENDIF #ELSE #SET(%ValueConstruct,%BrwLbl & ':Position') %[20]ValueConstruct ) #<! Record Position in Key Order #ENDIF CASE TC_PROP:BRW(%ListControl,TCPROP:Action) #<!Process Browse Actions OF TCACTION:FillQueue #<!Fill List Queue Action #IF(%RecordFilter) IF NOT(%RecordFilter) #<!If Filter Condition Not Met TC_PROP:BRW(%ListControl,TCPROP:SkipRecord,1) #<! Tell Browse to Skip Record CYCLE #<! No need to fill the Queue END #<!End If #ENDIF #IF(NOT %UsingViewStructure) #INSERT(%StandardSecondaryLookups) #ENDIF #EMBED(%FormatBrowse,'Format an element of the browse queue'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #INSERT(%StandardFormula,'Format Browse') #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #FOR(%QueueField) #! FOR each field in list %BrwLbl:%QueueField = %QueueFieldAssignment #<! Move Data to Queue #ENDFOR #IF(%ListBoxHasIcon) DO SetFieldIcons:%BrwLbl #<! Set Icons for List Box #ENDIF #IF(%ListBoxHasColor) DO SetFieldColors:%BrwLbl #<! Set Colors for List Box #ENDIF #<! #IF(NOT %UsingMultiDisplay AND %ScrollBehavior = 'Movable Thumb') OF TCACTION:DragThumb #<!Process Drag on Vertical Scroll Bar #CASE(%ScrollKeyDistribution) #OF('Alpha') Thumb%# = %ListControl{PROP:VScrollPos} #<! Calculate Thumb Position #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN Thumb%# = 101 - Thumb%#. #<! Adjust Thumb Position for Reverse Key Order #ENDIF %ThumbLocatorField = Sort:Alpha:Array[Thumb%#] #<! Set Thumb Position #OF('Last Names') Thumb%# = %ListControl{PROP:VScrollPos} #<! Calculate Thumb Position #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN Thumb%# = 101 - Thumb%#. #<! Adjust Thumb Position for Reverse Key Order #ENDIF %ThumbLocatorField = Sort:Name:Array[Thumb%#] #<! Set Thumb Position #OF('Numeric Range') #OROF ('Date Range') #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') %ValueConstruct = %ListControl{PROP:VScrollPos} #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN %ValueConstruct = 101 - %ValueConstruct. #ENDIF #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue' & ' = Sort:' & %BrwLbl & ':KeyValue' & ' * Sort:' & %BrwLbl & ':RangeStep' & ' + Sort:' & %BrwLbl & ':RangeFrom') %ValueConstruct #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') %ThumbLocatorField = %ValueConstruct #OF('Custom') #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':Custom:Array') Thumb%# = ROUND(%ListControl{PROP:VScrollPos} / | #<! Calculate Thumb Position (100 / MAXIMUM(%ValueConstruct,1)),1) #<! IF NOT Thumb%# THEN Thumb%# = 1. #<! #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN Thumb%# = 101 - Thumb%#. #<! Adjust Thumb Position for Reverse Key Order #ENDIF %ThumbLocatorField = %ValueConstruct[Thumb%#] #<! Set Key Field for Redisplay #OF('Other') Thumb%# = ROUND(%ListControl{PROP:VScrollPos} / | #<! Calculate Thumb Position (100 / MAXIMUM(%KeyArrayName,1)),1) #<! IF NOT Thumb%# THEN Thumb%# = 1. #<! #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN Thumb%# = 101 - Thumb%#. #<! Adjust Thumb Position for Reverse Key Order #ENDIF %ThumbLocatorField = %KeyArrayName[Thumb%#] #<! Set Key Field for Redisplay #ENDCASE POST(TCEVENT:SetToKey,%ListControl) #<! Set to Key and Redisplay List #<! #?OF TCACTION:SetThumb #<!Process Set Thumb Position #CASE(%ScrollKeyDistribution) #OF('Alpha') LOOP Thumb%# = 1 TO 100 IF Sort:Alpha:Array[Thumb%#] => UPPER(SUB(%ThumbLocatorField,1,2)) THEN BREAK. END #OF('Last Names') LOOP Thumb%# = 1 TO 100 IF Sort:Name:Array[Thumb%#] => UPPER(SUB(%ThumbLocatorField,1,3)) THEN BREAK. END #OF('Numeric Range') #OROF ('Date Range') LOOP Thumb%# = 1 TO 100 #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') %ValueConstruct = Thumb%# #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue' & ' = Sort:' & %BrwLbl & ':KeyValue' & ' * Sort:' & %BrwLbl & ':RangeStep' & ' + Sort:' & %BrwLbl & ':RangeFrom') %ValueConstruct #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':KeyValue') IF %ValueConstruct => %ThumbLocatorField BREAK END END #OF('Custom') #SET(%ValueConstruct,'SORT:' & %BrwLbl & ':Custom:Array') LOOP Thumb%# = 1 TO MAXIMUM(%ValueConstruct,1) #<! Read Key Distribution Array IF %ValueConstruct[Thumb%#] => | #<! If Key => Current Field Value UPPER(SUB(%ThumbLocatorField,1,LEN(%ValueConstruct[1]))) BREAK #<! Thumb Position Found END #<! End If END #<! End Loop Thumb%# = ROUND(100 / MAXIMUM(%ValueConstruct,1) * (Thumb%#-1),1) #OF('Other') LOOP Thumb%# = 1 TO MAXIMUM(%KeyArrayName,1) #<! Read Key Distribution Array IF %KeyArrayName[Thumb%#] => | #<! If Key => Current Field Value UPPER(SUB(%ThumbLocatorField,1,LEN(%KeyArrayName[1]))) BREAK #<! Thumb Position Found END #<! End If END #<! End Loop Thumb%# = ROUND(100 / MAXIMUM(%KeyArrayName,1) * (Thumb%#-1),1) #ENDCASE #IF(%UsingRevKeyOrder) IF RevOrder:%BrwLbl THEN Thumb%# = 101 - Thumb%#. #<! Adjust Thumb Position for Reverse Key Order #ENDIF %ListControl{PROP:VScrollPos} = Thumb%# #<! Set the Thumb Position #<! #ENDIF #SUSPEND #?OF TCACTION:DisplayFields #<!Display Fields Action #EMBED(%BeforeHotFieldsDisplay,'Before Hot Fields Display'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #INSERT(%StandardFormula,'Before Lookups') #IF(NOT %UsingViewStructure) #INSERT(%StandardSecondaryLookups) #ENDIF #INSERT(%StandardFormula,'After Lookups') #FIX(%Control,%ListControl) #SUSPEND #EMBED(%RedisplayChildListBoxes,'Redisplay Child List Boxes'),%Control,HIDE #?TC:BRW:ActiveList = %ListControl #<! Reset List Box as Being Active #RESUME #IF(%HotDisplay) DISPLAY() #<! Display All Fields #ENDIF #SUSPEND #?IF RECORDS(%ListQueue) #<! If Records Displayed #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #FOR(%Control),WHERE(%Control=%ListControl) #EMBED(%EnableSaveButtons,'Enable Save Buttons'),%Control,HIDE #ENDFOR #?ELSE #<! Else #FOR(%Control),WHERE(%Control=%ListControl) #EMBED(%DisableSaveButtons,'Disable Save Buttons'),%Control,HIDE #ENDFOR #?END #<! End If #RESUME #EMBED(%AfterHotFieldsDisplay,'After Hot Fields Display'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #? #<! #RESUME #SUSPEND #?OF TCACTION:NoRecords #<!No Records to Display Action #SUSPEND #?IF TC:BRW:DeletedLast #<!If Last Record Deleted #EMBED(%LastRecordDeleted,'Browse Box, last record deleted'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #?END #<!End If #RESUME #EMBED(%BrowseBoxEmpty,'Browse Box, no records found'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #FOR(%Control),WHERE(%Control=%ListControl) #EMBED(%NoRecordsAction,'No Records Action'),%Control,HIDE #ENDFOR #? #<! #RESUME #SUSPEND #?OF TCACTION:FirstRecord #<!On Insert of First Record Action #EMBED(%OnInsertFirstRecord,'Browse Box, on insert of first record'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #? #<! #RESUME OF TCACTION:ExitBrowse #<!Exit Browse Action BREAK #<! END #<!End Process Browse Actions END #<!End Process File Browse Loop #!------------------------------------------------------------------------- #GROUP(%ComboAutoFillSearchRoutine) #IF(%ComboLocatorType = 'Auto Fill') #COMMENT(100) !--------------------------------------------------------------------------------------------------! ! AutoFillSearch:%BrwLbl Routine #<! ! ! ! This routine processes a auto fill search for %ListControl #<! !--------------------------------------------------------------------------------------------------! #COMMENT(%CmtPos) #SET(%ValueConstruct,'AutoFillSearch:' & %BrwLbl) %[20]ValueConstruct ROUTINE IF TC_PROP:BRW(%ListControl,TCPROP:DroppedDown) THEN EXIT. #<!Don't Search if Combo is Dropped Down #IF(%RecordFilter) LOOP #INSERT(%CallAutoFillFunction,24) #<! IF NOT FilterFlag%# THEN BREAK. #<!Exit Loop if No Need to Check Filter IF %RecordFilter THEN CYCLE. #<!Stop Search if Record Filter OK TC:AUT:SkipRecord = True #<!Tell Search to Skip to Next Record END #ELSE #INSERT(%CallAutoFillFunction,10) #ENDIF %ListControl{PROP:Touched} = True #<!Set Entry Field as Changed #INSERT(%SetRelatedComboFields) #ENDIF #!------------------------------------------------------------------------- #GROUP(%CallAutoFillFunction,%Indent) #IF(%RecordFilter) #IF(%UsingViewStructure) FilterFlag%# = TC_AutoFill(VIEW:%[15]ListQueue ,| #<!File Name #ELSE FilterFlag%# = TC_AutoFill(%[20]File ,| #<!File Name #ENDIF #ELSE #IF(%UsingViewStructure) TC_AutoFill(VIEW:%[15]ListQueue ,| #<!File Name #ELSE TC_AutoFill(%[20]File ,| #<!File Name #ENDIF #ENDIF #SET(%ValueConstruct,%FilePrefix & ':RECORD') %[%Indent]Null %[20]ValueConstruct ,| #<!Record Area %[%Indent]Null %[20]Key ,| #<!Key Order for Display %[%Indent]Null %[20]LocatorName ,| #<!Field to Lookup #IF(%RangeField) %[%Indent]Null %[20]ControlUse ,| #<!Entry Field to Fill #IF(%RecordFilter) #SET(%ValueConstruct,'True') %[%Indent]Null %[20]ValueConstruct ,| #<!Enable Record Filtering #ELSE #SET(%ValueConstruct,'False') %[%Indent]Null %[20]ValueConstruct ,| #<!Disable Record Filtering #ENDIF #IF(%FilterKeySeg1) #SET(%EndOfProcedureCall,',|') #ELSE #SET(%EndOfProcedureCall,')') #ENDIF #IF(%RangeIsString = 'GROUP') #SET(%ValueConstruct,'GRP:' & %RangeField) %[%Indent]Null %[20]ValueConstruct ,| #<!Range Field #ELSE %[%Indent]Null %[20]RangeField ,| #<!Range Field #ENDIF #CASE(%RangeLimitType) #OF('Current Value') #SET(%SaveRangeField,'SAVE:' & %BrwLbl & ':' & %RangeField) %[%Indent]Null %[20]SaveRangeField ,| #<!Match Range - Low Value %[%Indent]Null %[20]SaveRangeField %EndOfProcedureCall #<!Match Range - High Value #OF('Single Value') %[%Indent]Null %[20]RangeLimit ,| #<!Match Range - Low Value %[%Indent]Null %[20]RangeLimit %EndOfProcedureCall #<!Match Range - High Value #OF('Range of Values') %[%Indent]Null %[20]RangeLow ,| #<!Match Range - Low Value %[%Indent]Null %[20]RangeHigh %EndOfProcedureCall #<!Match Range - High Value #OF('File Relationship') %[%Indent]Null %[20]RelationRangeLimit ,| #<!Match Range - Low Value %[%Indent]Null %[20]RelationRangeLimit %EndOfProcedureCall #<!Match Range - High Value #ENDCASE #IF(%FilterKeySeg3) %[%Indent]Null %[20]FilterKeySeg3 ,| #<!Filter Key Component %[%Indent]Null %[20]FilterKeySegLink3 ,| #<!Filter Key Component Value #ENDIF #IF(%FilterKeySeg2) %[%Indent]Null %[20]FilterKeySeg2 ,| #<!Filter Key Component %[%Indent]Null %[20]FilterKeySegLink2 ,| #<!Filter Key Component Value #ENDIF #IF(%FilterKeySeg1) %[%Indent]Null %[20]FilterKeySeg1 ,| #<!Filter Key Component %[%Indent]Null %[20]FilterKeySegLink1 ) #<!Filter Key Component Value #ENDIF #ELSE %[%Indent]Null %[20]ControlUse ,| #<!Entry Field to Fill #IF(%RecordFilter) #SET(%ValueConstruct,'True') %[%Indent]Null %[20]ValueConstruct ) #<!Enable Record Filtering #ELSE #SET(%ValueConstruct,'False') %[%Indent]Null %[20]ValueConstruct ) #<!Disable Record Filtering #ENDIF #ENDIF #!------------------------------------------------------------------------- #GROUP(%AddComboRecordRoutine) #IF(%ComboUpdateProcedure) #COMMENT(100) !--------------------------------------------------------------------------------------------------! ! AddComboRecord:%BrwLbl Routine #<! ! ! ! This routine adds a new record for a drop combo. #<! !--------------------------------------------------------------------------------------------------! #COMMENT(%CmtPos) #SET(%ValueConstruct,'AddComboRecord:' & %BrwLbl) %[20]ValueConstruct ROUTINE IF NOT %ListControlUse THEN EXIT. %LocatorName = %ListControlUse GET(%File,%Key) IF NOT ERRORCODE() THEN EXIT. BEEP(1) Button%# = MESSAGE('Would you like to add a new record?', | 'Record Not On File',| ICON:Question,BUTTON:Yes+BUTTON:No) IF Button%# = BUTTON:Yes #EMBED(%BeforeInsertRecord,'Before Inserting a Record'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) GET(%File,0) CLEAR(%FilePrefix:RECORD) %LocatorName = %ListControlUse GlobalRequest = InsertRecord %ComboUpdateProcedure IF GlobalResponse = RequestCompleted #INSERT(%SetRelatedComboFields) DISPLAY(%ListControl) POST(EVENT:Accepted,%ListControl) EXIT END #EMBED(%AfterInsertRecord,'After Inserting a Record'),%ActiveTemplateInstance,MAP(%ActiveTemplateInstance,%ActiveTemplateinstanceDescription) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) END CLEAR(%ListControlUse) SELECT(%ListControl) %ListControl{PROP:Touched} = True #ENDIF #!------------------------------------------------------------------------- 
